!  First process on the CRSP Compustat - merged data created with SAS
!    In this job all I want to do is identify all cases where there are multiple permnos corresponding to 1 permco.
IMPLICIT NONE
INTEGER, DIMENSION(700) :: VPCI,NAS
INTEGER, DIMENSION(700,50) :: PERMNO
INTEGER, DIMENSION(2) :: pmn
INTEGER :: pci,nobsi,nobsj,nmtl,i,j,icm,nuc,ja,jb,ifm,errcod
OPEN(unit= 19, file='/Users/lamlap/BSV/2022/data/MULTPNfue22.dat', STATUS ='OLD',READONLY,iostat= errcod)
OPEN(unit=20, file='/Users/lamlap/BSV/2022/data/MULTPNS22.dat', STATUS ='REPLACE')
!
!  Identify the cases where there are multiple permnos with the same permco.
!
NMTL=550   !  661 on 2/22/16   ! 493 on 2/15/16
DO i=1,NMTL
   READ (19,1966) pci,pmn(1),pmn(2),NOBSi,NOBSj; 1966 format (5(i5,2x))
   IF (i == 1) THEN
      VPCI(1)=pci; PERMNO(1,1)=pmn(1); PERMNO(1,2)=pmn(2); NAS(1)=2; NUC=1
   ELSE
      ICM=0
      DO j=1,NUC
         IF (pci == VPCI(j)) THEN    !  We already have the PERMCO
            ICM=1
            DO jb=1,2
               IFM=0
               DO ja=1,NAS(j)
                  IF (pmn(jb) == permno(j,ja)) IFM=1
               END DO
               IF (IFM == 0) THEN
                  NAS(j)=NAS(j)+1; PERMNO(j,NAS(j))=pmn(jb)
               END IF
            END DO
         END IF
      END DO
      IF (ICM ==0) THEN
         NUC=NUC+1
         VPCI(NUC)=pci; PERMNO(NUC,1)=pmn(1); PERMNO(NUC,2)=pmn(2); NAS(NUC)=2
      END IF
   END IF
END DO
PRINT 671, NUC; 671 format (' number of unique permcos: ',i3)
DO i=1,NUC
   WRITE (20,196) VPCI(i),NAS(i); 196 format (i5,2x,i3)
   DO j=1,NAS(i)
      WRITE (20,206) PERMNO(i,j); 206 format (2x,i5)
   END DO
END DO
STOP; END
